perm filename SL.NEW[1,JRA]1 blob
sn#062829 filedate 1973-09-20 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 (DEFPROP POSBIT
00003 00003 (DEFPROP RESOLVE
00006 ENDMK
⊗;
(DEFPROP POSBIT
(LAMBDA (X) (LIST (QUOTE CADAAR) (CADR X)))
MACRO)
(DEFPROP NEGBIT
(LAMBDA (X) (LIST (QUOTE CDDAAR) (CADR X)))
MACRO)
(DEFPROP NEGL
(LAMBDA (C) (LIST (QUOTE CADAR) (CADR C)))
MACRO)
(DEFPROP RESOLVE
(LAMBDA(C D)
(COND ((OR (ALLNEG D) (ALLPOS C)) (RESOLVE1 C D))
((OR (ALLPOS D) (ALLNEG C)) (RESOLVE1 D C))
(T (NCONC (RESOLVE1 C D) (RESOLVE1 D C)))))
EXPR)
(DEFPROP RESOLVE1
(LAMBDA(C D)
(PROG (CB DB DB1 YC YD YD1 Z X Y RES)
(SETQ YC (CDR C))
(SETQ CB (POSBIT C))
(SETQ YD1 (NEGL D))
(SETQ DB1 (NEGBIT D))
(SETQ DB DB1)
(SETQ YD YD1)
RES1 (SETQ X (CAR YC))
(COND ((NEG X) (RETURN RES)))
(SETQ Y (CAR YD))
(COND ((ORDERP (CAR X) (CADR Y)) (GO RES3)) ((NOT (EQ (CAR X) (CADR Y))) (GO RES4)))
(SETQ YD1 YD)
(SETQ DB1 DB)
(GO RES2A)
RES2 (SETQ Y (CAR YD))
(COND ((NOT (EQ (CAR X) (CADR Y))) (GO RES3A)))
RES2A
(COND ((NOT (UNIFAB (CAR CB) (CAR DB))) (GO RES2B)))
(SETQ Z (UNIFY (CDR X) (CDDR Y)))
(COND ((NULL Z) (GO RES2B)))
(SETQ PARRES NIL)
(SETQ Z (UNION (CDR Z) C D X Y))
(COND ((NULL Z) (GO RES2B)) ((NULL (CAR Z)) (RETURN Z)))
(SETQ RES (CONS (SET2 (CAR (COND (DLIST (DEMOD Z DLIST)) (EQUAL (ORDEREQUAL1 Z)) (T Z))) TBL) RES))
RES2B
(SETQ YD (CDR YD))
(COND (YD (SETQ DB (CDR DB)) (GO RES2)))
RES3A
(SETQ DB DB1)
(SETQ YD YD1)
RES3 (SETQ YC (CDR YC))
(COND (YC (SETQ CB (CDR CB)) (GO RES1)))
(RETURN RES)
RES4 (SETQ YD (CDR YD))
(COND (YD (SETQ DB (CDR DB)) (GO RES1)))
(GO RES3A)))
EXPR)